home *** CD-ROM | disk | FTP | other *** search
/ Windows Expert / Windows Expert.iso / windownt / perlnt.zip / eg / find83.cmd next >
OS/2 REXX Batch file  |  1993-07-25  |  2KB  |  119 lines
  1. @rem = '-*- Perl -*-';
  2. @rem = '
  3. @echo off
  4. perl -S %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. ';
  7.  
  8. #
  9. # version of find.pl that works on nt
  10. #
  11.  
  12. require 'ntfind.pl';
  13. require 'getopts.pl';
  14.  
  15. &Getopts('i');
  16.  
  17. @badmsg = @badfiles = ();
  18.  
  19. #
  20. # find all the files that don't fit the stupid 8.3 filename rules
  21. #
  22.  
  23. foreach $dir (@ARGV) {
  24.     &find($dir) if -d $dir;
  25. }
  26.  
  27. #
  28. # Now print them out
  29. #
  30.  
  31. while(@badfiles > 0) {
  32.     $file = pop (@badfiles);
  33.     $msg = pop (@badmsg);
  34.     if ($opt_i) {
  35.     &do_rename($file, $msg);
  36.     }
  37.     else {
  38.     print "$file : $msg\n";
  39.     }
  40. }
  41.  
  42. sub wanted {
  43.     local ($msg);
  44.     if ($msg = &checkname($_)) {
  45.     push(@badfiles, $name);
  46.     push(@badmsg, $msg);
  47.     }
  48. }
  49.  
  50. sub checkname {
  51.     local(@parts) = split (/\./, $_[0]);
  52.     local($checkmsg) = "";
  53.  
  54.     if ($#parts > 2) {
  55.     $checkmsg = "too many dots";
  56.     }
  57.     elsif (length($parts[0]) > 8) {
  58.     $checkmsg =  "name greater than 8 characters";
  59.     }
  60.     elsif (length($parts[1]) > 3) {
  61.     $checkmsg = "extension greater than 3 characters";
  62.     }
  63.     $checkmsg;
  64. }
  65.  
  66. sub do_rename {
  67.     local($path, $msg) = @_;
  68.     local($valid_name) = 0;
  69.     local($newname);
  70.  
  71.     #
  72.     # Tell the user what's wrong with the file, then prompt
  73.     # for a new name. Make sure that the new name doesn't exist,
  74.     # and that it's a legal 8.3 name. Then do the rename.
  75.     #
  76.  
  77.     $path =~ s|/|\\|g;
  78.  
  79.     do {
  80.     print "$msg\nRename $path to: ";
  81.     $newname = &gets;
  82.     if (-e $newname) {
  83.         print STDERR "Can't rename $file to $newname (file exists)\n";
  84.         redo;
  85.     }
  86.     split(m;[/\\];, $newname);
  87.     if (($msg = &checkname($_[$#_])) == ""){
  88.         rename($path, $newname) && ($valid_name = 1);
  89.         warn "rename of $path to $newname failed: $!\n" 
  90.         if $valid_name == 0;
  91.     }
  92.     } while (! $valid_name);
  93.  
  94.     #
  95.     # Now log the old and new names
  96.     #
  97.  
  98.     open(M, ">>rename.map") 
  99.     || warn "Can't open rename.map for append: $!\n" && return;
  100.     print M "$file -> $newname\n";
  101.     close M;
  102. }
  103.  
  104. sub gets {
  105.     local ($c);
  106.     local (@string) = ();
  107.  
  108.     while(($c = getc) ne "\n") {
  109.     push(@string, $c);
  110.     }
  111.     join (//, @string);
  112. }
  113.  
  114.  
  115.  
  116. __END__
  117. :endofperl
  118.  
  119.